home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).adf / Examples / Mandel.p < prev    next >
Text File  |  1989-07-02  |  5KB  |  173 lines
  1. PROGRAM Mand;
  2.  
  3. {
  4.     Mandel.p is a Mandelbrot display program written by
  5.     Ralph Seguin, and included in the PCQ distribution with
  6.     his permission.  I don't know what the real and imaginary
  7.     components represent, but the following values produce a
  8.     reasonable image:
  9.         Real component     : 0.6
  10.         Imaginary comp    : 0.15
  11.         Zoom size    : 0.5
  12.         Iterations    : more than, say, 40
  13. }
  14.  
  15. {$I ":Include/Ports.i"   So we can check the window message port. }
  16. {$I ":Include/Intuition.i"  for OpenWindow(), OpenScreen(), CloseWindow() and CloseScreen(). }
  17. {$I ":Include/Graphics.i"   for Draw() and Move() functions. }
  18. {$I ":Include/Exec.i"}
  19.  
  20. VAR
  21.    H,V: INTEGER;        { Horizontal and vertical looping coordinates. }
  22.    K: INTEGER;          { Generic looping interger from Hell.  FOR K rules! }
  23.    W: WindowPtr;        { A pointer to our custom window after creation. }
  24.    S: ScreenPtr;        { A pointer to our custom defined screen. }
  25.    RP: RastPortPtr;     { a pointer to a rastport structure (record) so we can do plotting in a rastport (window). }
  26.    CR,CI,T: REAL;       { Current real and imaginary and a temp real. }
  27.    ZR,ZI: REAL;         { Z-real and imaginary coordinates. }
  28.    B: BOOLEAN;          { Generic boolean from hell for loop breaking. }
  29.    MaxIter: INTEGER;    { Maximum number of iterations to perform. }
  30.    RealC,ImgC,Zoom: REAL;   { Coordinates for corner and zoom box size. }
  31.    HoriF,VertF: REAL;     { Horizontal and Vertical Factors. }
  32.  
  33.  
  34.  
  35.  
  36. PROCEDURE CleanExit(St:STRING; RC:INTEGER);
  37.  
  38. BEGIN
  39.    IF (W <> NIL) THEN
  40.       CloseWindow(W);
  41.  
  42.    IF (S <> NIL) THEN
  43.       CloseScreen(S);
  44.  
  45.    IF (GfxBase <> NIL) THEN
  46.       CloseLibrary(GfxBase);
  47.  
  48.    WRITELN(St);
  49.    Exit(RC);
  50. END;   { CleanExit() }
  51.  
  52.  
  53.  
  54.  
  55. PROCEDURE SetColors;
  56.  
  57. VAR
  58.    K: INTEGER;
  59.    VP: ADDRESS;
  60.  
  61. BEGIN
  62.    VP := ViewPortAddress(W);
  63.  
  64.    FOR K := 0 TO 31 DO
  65.       SetRGB4(VP,K,K DIV 2,K MOD 2, K MOD 11);   { Set color K to R,G,B values. }
  66.  
  67. END;
  68.  
  69.  
  70. PROCEDURE Init;
  71.  
  72. CONST
  73.    NW: NewWindow = (0,19,320,380,1,7,CLOSEWINDOW_f,
  74.                     WINDOWDRAG_f+WINDOWCLOSE_f+SMART_REFRESH_f+BORDERLESS_f+ACTIVATE_f,
  75.                     NIL,NIL,"<-- Click me to stop",NIL,NIL,0,0,0,0,CUSTOMSCREEN_f);
  76.  
  77.    NS: NewScreen = (0,0,320,400,5,1,7,4,CUSTOMSCREEN_f,NIL,
  78.                     "SmallMandel, by Ralph Seguin, ESC Inc.",
  79.                     NIL,NIL);    { Our NewScreen structure }
  80.  
  81.  
  82. BEGIN { Init }
  83.    GfxBase := OpenLibrary("graphics.library",0);   { Open up the graphics.library. }
  84. { The graphics.library contains routines to do all the basic graphics, lines, }
  85. { circles, etc.  If you plan to use any of these, it is necessary to open this }
  86. { Always remember to close a library after you are finished using it, otherwise }
  87. { you will make the system unsafe. }
  88.  
  89.  
  90.    IF (GfxBase = NIL) THEN
  91.       CleanExit("Mandel: Couldn't open graphics.library!",20);
  92.  
  93.    S := OpenScreen(Adr(NS));
  94.  
  95.    IF (S = NIL) THEN
  96.       CleanExit("Unable to open screen.",5);
  97.  
  98.    NW.Screen := S;   { We can't assign this dynamically }
  99.    W := OpenWindow(Adr(NW));
  100.  
  101.    IF (W = NIL) THEN
  102.       CleanExit("Unable to open window.",5);
  103.  
  104.    SetColors;
  105.    RP := W^.RPort;   { Get a pointer to the rastport for the window we opened. }
  106. { A rastport is required to do any sort of graphics rendering. }
  107.  
  108. END;  { Init }
  109.  
  110.  
  111.  
  112.  
  113. BEGIN   { Main }
  114.  
  115.    WRITELN("       MandelHell 0.15, by Ralph Seguin.");
  116.    WRITELN;
  117.    WRITE("Enter real component: ");
  118.    READLN(RealC);
  119.    WRITE("Enter imaginary component: ");
  120.    READLN(ImgC);
  121.    WRITE("Enter zoom size: ");
  122.    READLN(Zoom);
  123.    WRITE("Maximum iteration count: ");
  124.    READLN(MaxIter);
  125.    Init;   { Initialize globals }
  126.    HoriF := Zoom / 320.0;
  127.    VertF := Zoom / 380.0;
  128.  
  129.    FOR V := 12 TO 380 DO BEGIN
  130.       CI := ImgC + VertF * Float(V);
  131.  
  132.       FOR H := 1 TO 320 DO BEGIN
  133.  
  134.          CR := HoriF * Float(H) + RealC;
  135.          ZR := 0.0;
  136.          ZI := 0.0;
  137.          B := TRUE;
  138.          K := 1;
  139.  
  140.          WHILE ((K <= MaxIter) AND B) DO BEGIN
  141.  
  142.             T := ZR;
  143.             ZR := Sqr(ZR) - Sqr(ZI) + CR;
  144.             ZI := 2.0 * T * ZI + CI;
  145.             K := SUCC(K);
  146.  
  147.             IF (Sqr(ZR) + Sqr(ZI) >= 4.0) THEN
  148.                B := FALSE;
  149.  
  150.          END;   { WHILE (K <= 100 AND B) }
  151.  
  152.          IF (K < MaxIter) THEN
  153.             SetAPen(RP,K MOD 31 + 1)
  154.          ELSE
  155.             SetAPen(RP,0);
  156.  
  157.          Move(RP,H,V);   { Move to this point in the Window (RastPort). }
  158.          Draw(RP,H,V);   { Draw at this point. }
  159.       END;   { FOR H := 1 TO 100 }
  160.  
  161.       IF (CheckBreak() OR (GetMsg(W^.UserPort) <> NIL)) THEN BEGIN
  162.          WHILE (GetMsg(W^.UserPort) <> NIL) DO ;
  163.          CleanExit("Have a nice day.",0);
  164.       END;
  165.  
  166.    END;   { FOR V := 1 TO 80 }
  167.  
  168.    if WaitPort(w^.UserPort) = Nil then;
  169.    
  170.    WHILE (GetMsg(W^.UserPort) <> NIL) DO ;
  171.    CleanExit("Have a nice day.",0);
  172. END.   { Main }
  173.